(DE PATMATCH NIL (PROG (X1 X2 Y)
                    (SETQ X1 (REEDITFACE (FACES)))
                    (SETQ X2 PATS)
                 B  (SETQ CURPAT (CAR X2))
                    (SETQ Y (FACEMATCH X1 (PATFACE (CAR X2))))
                    (COND ((NULL Y) (GO A)))
                    (SETQ Y (NODEPICK1 Y (PATNODFC (CAR X2))))
                    (SETQ Y (NODEPICK2 Y))
                    (AND Y (RETURN (SETQ PATSELECT (PATPTS Y (PATPOINTS CURPAT)))))
                 A  (COND ((SETQ X2 (CDR X2)) (GO B)))
                    (RETURN NIL)))

  (DE REEDITFACE (X)
      (PROG (Y Z Y1 Z1)
            (SETQ Y1 (SETQ Y (CADR X)))
            (SETQ Z1 (SETQ Z (FOR NEW Y IN (CADDR X) LIST (LIST Y))))
            (COND ((NULL Y) (GO A)))
          B (COND ((NULL (CDR Y)) (GO A))
                  ((EQ (CAR Y) (CADR Y)) (GO C)))
            (SETQ Y (CDR Y))
            (SETQ Z (CDR Z))
            (GO B)
          C (RPLACD Y (CDDR Y))
            (RPLACD (CADR Z) (CAR Z))
            (RPLACA Z (CADR Z))
            (RPLACD Z (CDDR Z))
            (GO B)
          A (RETURN (LIST (CAR X) Y1 Z1))))
  (DE FACES NIL (PROG (X)
                      (SETQ FACE NIL)
                      (SETQ FACENUM 0)
                      (FOR X := (1 (PLUS NMX -2))
                        DO (FACEF1 X X NIL (ADD1 (DIFFERENCE NMX X)) 1))
                      (EDITFACE)
                      (RETURN FACE)))

  (DE FACEF1 (FST Z LST MXLV LV)
      (PROG (X Y)
            (SETQ Y (CONN Z))
          A (COND ((NULL Y) (RETURN NIL)))
            (SETQ X (CAR Y))
            (COND ((EQ X FST) (OTFACE FST LST))
                  ((MEMQ X LST) NIL)
                  ((EQ LV MXLV) NIL)
                  (T (FACEF1 FST X (CONS X LST) MXLV (ADD1 LV))))
            (SETQ Y (CDR Y))
            (GO A)))

  (DE OTFACE (X Y)
      (PROG NIL
	    (COND ((EQ (LENGTH Y) 1) (RETURN NIL)))
            (SETQ X (CONS X Y))
            (COND ((DUPFACE X) (RETURN NIL)))
            (SETQ FACENUM (ADD1 FACENUM))
            (SETQ FACE (CONS (LIST FACENUM (LENGTH X) X) FACE))
            (RETURN NIL))))))))

  (DE DUPFACE (X) (FOR NEW Y IN FACE OR (SETEQ X (CADDR Y))))

  (DE SETEQ (X Y) (AND (EQ (LENGTH X) (LENGTH Y))
                       (EQ (LENGTH X) (LENGTH (UNION X Y)))))
  (DE EDITFACE NIL (PROG (X)
     (SETQ FACE (SORT FACE (FUNCTION (LAMBDA (X Y)
                            (GREATERP (FACESIZE X) (FACESIZE Y))))))
     (SETQ X (MAPCAR (FUNCTION FACESIZE) FACE))
     (RETURN (SETQ FACE (LIST (LENGTH X) X FACE)))))

  (DE FACESIZE (X) (LENGTH (CADDR X)))

  (DE FACEMATCH (F1 F2)
      (PROG (X1 X2 Y1 Y2 Z)
            (COND ((LESSP (CAR F1) (CAR F2)) (RETURN NIL)))
            (SETQ X1 (CADR F1))
            (SETQ X2 (CADR F2))
            (SETQ Y1 (CADDR F1))
            (SETQ Y2 (CADDR F2))
         A (COND ((LESSP (CAR X1) (CAR X2)) (RETURN NIL))
                  ((EQ (CAR X1) (CAR X2)) (GO B)))
            (SETQ Y1 (CDR Y1))
            (COND ((NULL (SETQ X1 (CDR X1))) (RETURN NIL)))
            (GO A)
         B  (SETQ Z (CONS (CONS (CAAR Y2) (CAR Y1)) Z))
            (SETQ Y2 (CDR Y2))
            (COND ((SETQ X2 (CDR X2)) (GO A)))
            (RETURN Z)))